home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HEAPSPY.ZIP / HWHEXDMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  5.8 KB  |  237 lines
  1. {$A-,B-,E-,F-,G+,I-,K-,N-,O-,P-,Q-,R-,S-,T+,V-,W-,X+}
  2.  
  3. {**********************************************}
  4. {                                              }
  5. {   HeapSpy - HWHexDump Module                 }
  6. {   Copyright (c) 1992  Borland International  }
  7. {                                              }
  8. {**********************************************}
  9.  
  10. unit HWHexDmp;
  11.  
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13.  
  14. interface
  15.  
  16. uses Wintypes, WinProcs, Objects, ODialogs, OWindows, Strings, HWGlobal;
  17.  
  18. type
  19.   PHexDmpWin = ^THexDmpWin;
  20.   THexDmpWin = object(TBasicHexWin)
  21.     hMem: Word;
  22.     StartOfs: LongInt;
  23.     BlockSize: LongInt;
  24.     procedure SetupWindow; virtual;
  25.     constructor Init(AParent: PWindowsObject; AhMem: Word; AStartOfs: Word;
  26.       ABlockSize: LongInt);
  27.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  28.     procedure WMKeyDown(var Msg: TMessage); virtual wm_first+wm_KeyDown;
  29.     procedure Paint(PaintDC: hDC; var PaintStruct: TPaintStruct); virtual;
  30.     procedure WMSize(var Msg: TMessage);
  31.       virtual wm_First + wm_Size;
  32.     procedure WMSetFont(var Msg: TMessage);
  33.       virtual wm_First + wm_SetFont;
  34.   end;
  35.  
  36. implementation
  37.  
  38. type
  39.   LongRemap = record
  40.     case integer of
  41.       0: (O,S: Word);
  42.       1: (P: Pchar);
  43.       2: (L: LongInt);
  44.     end;
  45.  
  46. constructor THexDmpWin.Init;
  47. var
  48.   Temp: array[0..127] of Char;
  49.   DC: hDc;
  50.   TM: TTextMetric;
  51.   PrevFont: THandle;
  52.   ParRect: TRect;
  53. begin
  54.   hMem := (AhMem and $FFF8) or (CSeg and 7);
  55.   if not IsValidSelector(hMem) then Fail;
  56.   StartOfs := AStartOfs;
  57.   BlockSize := ABlockSize;
  58.   Inc(BlockSize,StartOFs);
  59.   WVSPrintF(TEMP,'Block Dump - %#4X',hMem);
  60.   inherited Init(AParent,Temp);
  61.   DC := GetDC(0);
  62.   PrevFont := SelectObject(DC,HexDumpFont);
  63.   GetTextMetrics(DC,TM);
  64.   SelectObject(DC,PrevFont);
  65.   ReleaseDC(0,DC);
  66.   with Attr do
  67.   begin
  68.     Style := Style or ws_vscroll or WS_HScroll ;
  69.     w := tm.tmAveCharWidth*81;
  70.     GetClientRect(Parent^.hWindow,ParRect);
  71.     if w > ParRect.right then w := ParRect.right;
  72.   end;
  73.   Scroller := New(PScroller,Init(@Self,8,15,76,BlockSize div 16));
  74.   Scroller^.XUnit := tm.tmAveCharWidth;
  75.   Scroller^.YUnit := tm.tmHeight;
  76.   { AutoOrg MUST be false so that the scrolling action can handle
  77.     a block with more than 32K lines }
  78.   Scroller^.AutoOrg := False;
  79. end;
  80.  
  81. procedure THexDmpWin.WMSetFont;
  82. var
  83.   DC: hDc;
  84.   TM: TTextMetric;
  85.   PrevFont: THandle;
  86. begin
  87.   DC := GetDC(0);
  88.   PrevFont := SelectObject(DC, Msg.wParam);
  89.   GetTextMetrics(DC, TM);
  90.   SelectObject(DC, PrevFont);
  91.   ReleaseDC(0, DC);
  92.   Scroller^.XUnit := tm.tmAveCharWidth;
  93.   Scroller^.YUnit := tm.tmHeight;
  94.   InvalidateRect(hWindow, nil, true);
  95. end;
  96.  
  97. procedure THexDmpWin.SetupWindow;
  98. begin
  99.   inherited SetupWindow;
  100.   Scroller^.SetPageSize;
  101. end;
  102.  
  103. procedure THexDmpWin.GetWindowClass;
  104. begin
  105.   inherited GetWindowClass(WndClass);
  106.   WndClass.hIcon := LoadIcon(hInstance, PChar(ico_hexdmp));
  107. end;
  108.  
  109. procedure THexDmpWin.WMKeyDown;
  110. var
  111.   CtrlPress: boolean;
  112. begin
  113.   CtrlPress := GetKeyState(VK_CONTROL) < 0;
  114.   if Scroller <> nil then
  115.   with Scroller^ do
  116.     case Msg.wParam of
  117.       vk_Up: ScrollBy(0,-1);
  118.       vk_Down: ScrollBy(0,1);
  119.       vk_Left: ScrollBy(-1,0);
  120.       vk_Right: ScrollBy(1,0);
  121.       vk_Home: ScrollTo(0,Ypos);
  122.       vk_End: ScrollTo(XRange,YPos);
  123.       vk_Prior:
  124.         if not CtrlPress then
  125.           ScrollBy(0,-YPage)
  126.         else
  127.           ScrollTo(0,0);
  128.       vk_Next:
  129.         if not CtrlPress then
  130.           ScrollBy(0,YPage)
  131.         else
  132.           ScrollTo(XRange,YRange);
  133.     end;
  134. end;
  135.  
  136. procedure THexDmpWin.WMSize;
  137. const
  138.   InProc: boolean = False;
  139. var
  140.   cx,cy: integer;
  141.   R: TRect;
  142. begin
  143.   inherited WMSize(MSg);
  144.   if hWindow <> 0 then
  145.     if Scroller <> nil then
  146.        with Scroller^ do
  147.          SetRange(76-XPage,(BlockSize div 16)-Ypage);
  148. end;
  149.  
  150. procedure HexByte(var Dest; chv: Char); assembler;
  151. asm
  152.     CLD
  153.     LES    DI,Dest
  154.     MOV    AL,chv
  155.     MOV    AH,AL
  156.     MOV    CX,4
  157.     SHR    AL,CL
  158.     OR    AL,$30
  159.     CMP    AL,$39
  160.     JBE    @1
  161.     ADD    AL,7
  162. @1:    STOSB
  163.     SHR    AX,CL
  164.     SHR    AL,CL
  165.     OR     AL,$30
  166.     CMP    AL,$39
  167.     JBE    @2
  168.     ADD    AL,7
  169. @2:    STOSB
  170. end;
  171.  
  172. procedure THexDmpWin.Paint;
  173. Var
  174.   Mem: PChar;
  175.   Temp: array[0..80] of Char;
  176.   j,ti: Word;
  177.   PrevFont: HFont;
  178.   i,X1,Y1,Y2: LongInt;
  179.   OldBKColor,
  180.   OldTxtColor: Word;
  181.   LO: LongRemap;
  182.   Ch: Char;
  183. begin
  184.   FillChar(Temp,81,' ');
  185.   PrevFont := SelectObject(PaintDC, HexDumpFont);
  186.   OldBkColor := SetBkColor(PaintDC, GetSysColor(color_Window));
  187.   OldTxtColor := SetTextColor(PaintDC, GetSysColor(color_WindowText));
  188.   with Scroller^ do
  189.   begin
  190.     X1 := YPos;
  191.     Y1 := X1+(PaintStruct.rcPaint.Top div YUnit);
  192.     Y2 := X1+(PaintStruct.rcPaint.Bottom div YUnit);
  193.     LO.L := (StartOfs and $FFF0)+(Y1*16);
  194.     Mem := Ptr((LO.S shl 3)+hMem,0); {!!! WIN3.x dependent }
  195.     for i := Y1 to y2 do
  196.       if LO.L < BlockSize then
  197.       begin
  198.         HexPtr(Temp,@Mem[LO.O]);
  199.         StrCat(Temp,'  ');
  200.         ti := 11;
  201.         for j := 0 to 15 do
  202.         begin
  203.           if (StartOfs > (LO.L+j)) or ((LO.L+j) >= BlockSize) then
  204.           begin
  205.             Ch := ' ';
  206.             FillChar(Temp[ti],3,' ');
  207.           end
  208.           else
  209.           begin
  210.             Ch := Mem[LO.O+j];
  211.             HexByte(Temp[ti],Ch);
  212.           end;
  213.           if Ch >= #32 then
  214.             Temp[60+j] := Ch
  215.           else
  216.             Temp[60+j] := '.';
  217.           Inc(ti,3);
  218.         end;
  219.         Temp[34] := '-';
  220.         Temp[76] := #00;
  221.         TextOut(PaintDC,(0-Xpos)*XUnit,(i-x1)*YUnit,Temp,76);
  222.         if LO.O >= $FFF0 then
  223.         begin
  224.           Inc(LO.L,16);
  225.           Mem := Ptr((LO.S shl 3)+hMem,0);  {!!! Win3.x dependant }
  226.         end
  227.         else
  228.            Inc(LO.O,16);
  229.       end;
  230.   end;
  231.   SelectObject(PaintDC,PrevFont);
  232.   SetTextColor(PaintDC,OldTxtColor);
  233.   SetBkColor(PaintDC,OldBkColor);
  234. end;
  235.  
  236. end.
  237.